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-- file Pass3I.Mesa 

-- last modified by Satterthwaite, July 16, 1978 10:00 AM 

DIRECTORY 

ComData: FROM "comdata" 

USING [importXtx, mainCtx, seAnon. textlndex, typeBOOLEAN, xref], 
CompilerDefs: FROM "compilerdef s" USING [AppendXrefWords] , 
CopierDefs: FROM "copierdefs" 

USING [CompleteContext, Delink. SearchFileCtx], 
ErrorDefs: FROM "errordefs" 

USING [error, errorhti, errorsei, WarningSei, errortree], 
P3Defs: FROM "p3defs" 
USING [ 
PSMark, 

BumpCount, Exp, LongPath, OperandType, ResolveReference, Rhs. 
RPop, RPush, RType. TargetType, UnionField, VariantUnionType, VoidExp, 
CheckExprLoop , CheckTypeLoop, LogExprLoop], 
PassS: FROM "pass3" USING [impl ici tTree, impl icitType], 
SymDefs: FROM "symdefs" 

USING [setype, ctxtype, mdtype, bodytype, 

HTIndex, SEIndex, ISEIndex, CSEIndex, recordCSEIndex, 
CTXIndex, includedCTXIndex, BTIndex, 

HTNull, SENull, ISENull, recordCSENul 1 , CTXNull . BTNull, 
IG, IZ. typeANY], 
SymTabDefs: FROM "symtabdef s" 
USING [ 

Constantid, f irstvisiblese, NextSe. NormalType, SearchContext. 
setselink, UnderType, visiblectxentries, XferMode], 
SystemDefs: FROM "systemdefs" 
USING [ 

AllocateHeapNode, AllocateSegment , FreeHeapNode, FreeSegment, 
SegmentSize], 
TableDefs; FROM "tabledefs" 

USING [TableBase, TableNotif ier] . 
TreeDefs: FROM "treedefs" 
USING [treetype, 

Treelndex, TreeLink, TreeMap, TreeScan, 
empty, nullid, 

CopyTree, freenode, freetree, GetNode, mlpop, mlpush, pushtree, 
scanlist, setattr, setinfo, setshared, shared, testtree, 
updatelist, UpdateTree], 
Xref JournalDefs: FROM "xref journaldef s" 
USING [RefData, ReferenceNumber, RefType]; 

Pass3I: PROGRAM 
IMPORTS 

CompilerDefs, CopierDefs, ErrorDefs, P3Defs, SymTabDefs, SystemDefs. 
TreeDefs, 

dataPtr: ComData, passPtr: Pass3 
EXPORTS P3Defs « 
BEGIN 
OPEN SymTabDefs, P3Defs, SymDefs, TreeDefs; 

Undeclaredldentifier: PUBLIC SIGNAL [HTIndex] RETURNS [ISEIndex] « CODE; 
Ambiguousldentifier: PUBLIC SIGNAL [ISEIndex] RETURNS [ISEIndex] « CODE; 

-- cross reference interface 

seqNumber : Xref JournalDefs .ReferenceNumber; 
RefType: TYPE = Xref JournalDefs .RefType; 

RecordReference: PUBLIC PROCEDURE [sei: ISEIndex, type: RefType] ■ 
BEGIN OPEN XrefJournalDefs; 
ref: RefData ^ [ 

symbol: sei, 

whereRefe fenced: dataPtr. textlndex, 

refTag: type, 

sequenceN umber: (seqNumber^-seqNumber+l)] ; 
Comp ilerDefs.AppendXref Words [0ref, SIZE[RefData]]; RETURN 
END; 



-- tables defining the current symbol table 

tb: TableDefs .TableBase; -- tree base 

seb: TableDefs. TableBase; -- se table 
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ctxb: TableDefs.TableBase; -- context table 

mdb: TableDefs.TableBase; -- module directory base 

bb: TableDefs.TableBase; -- body directory base 

IdNotify: PUBLIC TableDef s . TableNoti f ier - 

BEGIN -- called whenever the main symbol table is repacked 

tb ^ base[treetype]; 

seb ^ base[setype]; 

ctxb <- base[ctxtype]; mdb ♦- base[mdtype]; 

bb ♦" base[bodytype]; 

RETURN 

END; 

-- identifier look-up 

Id: PUBLIC PROCEDURE [hti: HTIndex] RETURNS [val : TreeLink] - 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 
baseV: TreeLink; 
indirect, const: BOOLEAN; 
[sei, baseV, indirect] <- FindSe[hti 
lUndeclaredldentif ier »> 
BEGIN 

IF hti ^ HTNull THEN ErrorDef s . errorhti[unknownId, hti]; 
RESUME [dataPtr.seAnon] 
END; 
Ambiguousldentif ier => 
BEGIN 

ErrorDefs .errorhti[ambiguousId, hti]; RESUME[dataPtr . seAnon] 
END]; 
IF sei » SENull 
THEN 
BEGIN 
IF (ctxb+(seb+sei) .ctxnum) . ctxType « included 

THEN BEGIN IF baseV = empty THEN CheckUnbased[sei] END 
ELSE 

IF ~(seb+sei) .mark3 
THEN ResolveId[sei 
ILogExprLoop =»> 
ErrorDef s.errorsei[circularValue, sei]]; 
BumpCount[sei]; 

IF dataPtr.xref THEN RecordReference[sei , mention]; 
type <- UnderType[(seb+sei) . idtype]; const <- ConstantId[sei]; 
RPush[type, const]; 
val *- TreeLink[symbol[index: sei]]; 
IF baseV # empty AND ~const 

AND (ctxb + (seb+sei) .ctxnum) . CtxType if imported 
THEN 

BEGIN CountTreeIds[baseV];- 
mlpush[baseV]; mlpush[val]; 
IF indirect 
THEN 
BEGIN 

pushtree[dot, 2]; 

setattr[l, (seb+OperandType[baseV]) . typetag » long]; 
END 
ELSE 
BEGIN 

pushtree[dollar , 2]; setattr[l, LongPath[baseV]]; 
END; 
setinfo[RType[]]; 
val ^ mlpop[]; 
END; 
END 
ELSE 
BEGIN 

CountTreeIds[baseV]; mlpush[baseV]; 
type ^ OperandType[baseV]; 
IF indirect 
THEN 
BEGIN 

pushtree[uparrow, 1]; setattr[l, (seb-^type) . typetag ■ long]; 
type <- NormalType[type]; 
type <r WITH (seb^-type) SELECT FROM 
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pointer »> UnderType[pointedtotype] , 
ENDCASE «> typeANY; 
setinfo[type]; 
END; 
val ♦- mlpop[]; RPush[type, FALSE]; 
END; 
RETURN 
END; 

Fieldid: PUBLIC PROCEDURE [hti: HTIndex, type: recordCSEIndex] 
RETURNS [n: CARDINAL, sei : ISEIndex] - 
BEGIN 

[n, sei] ^ SearchRecord[hti , type]; 
IF n # 
THEN 
BEGIN 

IF --(seb+sei) ,mark3 
THEN ResolveId[sei 

ILogExprLoop => ErrorDef s .errorsei[circu1arVa1ue, sei]]; 
BunipCount[sei]; 

IF dataPtr.xref THEN RecordReference[sei . mention]; 
END; 
RETURN 
END; 

DefinedId: PUBLIC PROCEDURE [hti: HTIndex. type: CSEIndex] 
RETURNS [found: BOOLEAN, sei: ISEIndex] « 
BEGIN 

WITH (seb+type) SELECT FROM 
definition «> 
BEGIN 

[found, sei] <- SearchCtxList[hti . defCtx]; 
IF found 
THEN 
BEGIN 

IF -'(seb+sei) .marks 
THEN ResolveId[sei 
ILogExprLoop »> 
ErrorDef s .errorsei[circu1 arValue. sei]]; 
CheckUnbased[sei]; BumpCount[sei]; 
IF dataPtr.xref THEN RecordReference[sei , mention]; 
END; 
END; 
ENDCASE »> BEGIN found <- FALSE; sei <- ISENull END; 
RETURN 
END; 

CompleteRecord: PUBLIC PROCEDURE [rSei: recordCSEIndex] « 
BEGIN 

ctx: CTXIndex = (seb+rSei) . f ieldctx; 
WITH (ctxb+ctx) SELECT FROM 
simple => NULL; 
included »> 

IF ctxievel - 1Z 

THEN CopierDefs.CompleteContext[LOOPHOLE[ctx, includedCTXIndex] . FALSE]; 
ENDCASE; 
RETURN 
END; 

-- keyed-list matching 

ArrangeKeys: PUBLIC PROCEDURE 

[expList: TreeLink, ctx: CTXIndex, omittedKey: PROCEDURE [ISEIndex] RETURNS [TreeLink]] 

RETURNS [nFields: CARDINAL] « 
BEGIN 
Pair: TYPE « RECORD[ 

key: ISEIndex. 

defined: BOOLEAN, 

attr: TreeLink]; 
i: CARDINAL; 

aList: DESCRIPTOR FOR ARRAY OF Pair; 
sei: ISEIndex; 
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Keyltem: TreeMap ■ 
BEGIN 

node: Treelndex; 
hti: HTIndex; 
i: CARDINAL; 
WITH t SELECT FROM 
subtree ■> 

BEGIN node <- index; 
WITH (tb+node).sonl SELECT FROM 
hash "> 

BEGIN hti ♦- index; 
FOR i IN [0 .. nFields) 
DO 

IF (seb+aList[i].key).htptr = hti 
THEN 
BEGIN 

IF ~aList[i]. defined 
THEN 

BEGIN aList[i].attr ^ (tb+node) .son2; 
(tb+node) .son2 <- empty; 
aList[i]. defined *- TRUE; 
END 
ELSE 

BEGIN ErrorDefs.errorhti[dupl icateKey, hti]; 
(tb+node) .son2 ♦- VoidExp[{tb+node) .son2]; 
END; 
EXIT 
END; 
REPEAT 

FINISHED => 

BEGIN ErrorDef s .errorhti[unknownKey , hti]; 
(tb+node) .son2 ♦- VoidExp[(tb+node) . son2]; 
END; 
ENDLOOP; 
freenode[node]; 
END; 
ENDCASE => ERROR; 
END; 
ENDCASE => ERROR; 
RETURN [empty] 
END; 

nFields ^ visiblectxentries[ctx]; 
aList <- DESCRIPTOR[ 

SystemDefs.AnocateHeapNode[nFields*SIZE[Pair]], 
nFields]; 
i ^ 0; 

FOR sei i- firstvisib1ese[ctx], NextSe[sei] UNTIL sei « SENull 
DO 

aList[i] *- Pair[key:sei , def ined:FALSE, attrrempty]; i ♦- i+1; 
ENDLOOP; 
expList <- f reetree[update1ist[expList, Keyltem]]; 
FOR i IN [0 .. nFields) 
DO 

mlpush[IF aList[i].def ined 
THEN aList[i].attr 
ELSE omittedKey[aList[i].key]]; 
ENDLOOP: 
SystemDef s . FreeHeapNode[BASE[ aList]] ; 
RETURN 
END; 



-- auxiliary service routines 

Resolveld: PROCEDURE [sei: ISEIndex] » 
BEGIN 

declNode: Treelndex; 
declNode ^ (seb+sei) . idvalue; 
IF (tb+declNode).mark ff P3Mark 
THEN ResolveReference[sei] 
ELSE 

IF SIGNAL CheckExprLoop[d0clNode] 
THEN SIGNAL LogExprLoop[declNode] ; 
RETURN 
END; 
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CheckUnbased: PROCEDURE [sei: ISEIndex] - 
BEGIN 

IF -'ConstantldCsei] 
THEN 

WITH (ctxb+(seb+sei).ctxnum) SELECT FROM 
included »> 

IF (ctxb+(seb+sei) .ctxnum) .ctxType ff imported 
THEN ErrorDefs.errorsei[notImported, sei] 
ELSE ErrorDefs,errorsei[missingBase, sei]; 
ENDCASE; 
RETURN 
END; 

CountTreelds: PUBLIC TreeScan ■ 

BEGIN -- traverses the tree, incrementing reference counts for ids 

Countlds: TreeMap ■ 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol «> 

BEGIN sei ♦- index; 
BumpCount[sei]; 

IF dataPtr.xref THEN RecordReference[sei , implicit]; 
END; 
subtree => [] <- UpdateTree[t . Countlds]; 
ENDCASE «> NULL; 
RETURN [t] 
END; 

[] ^ CountIds[t]; RETURN 
END; 

LambdaApply: PUBLIC PROCEDURE [t: TreeLink, formal, actual: ISEIndex] RETURNS [TreeLink] 
BEGIN 

Substitute: TreeMap » 
BEGIN 

sei: ISEIndex; 
WITH t SELECT FROM 
symbol »> 

BEGIN sei *■ index; 
IF sei = formal THEN sei ♦- actual; 
BumpCount[sei]; 

IF dataPtr.xref THEN RecordReference[sei , implicit]; 
V ♦- [symbol [index: sei]]; 
END; 
subtree »> 
IF shared[t] 

THEN BEGIN CountTreeIds[t] ; v <- t END 
ELSE V ^ CopyTree[[baseP:@tb, link:t]. Substitute]; 
ENDCASE => V <- t; 
RETURN 
END; 

RETURN [Substitute[t]]; 
END; 

-- context stack management 

ContextEntry: TYPE « RECORD[ 

base: TreeLink, -- the basing expr (empty if none) 

indirect: BOOLEAN, -- true iff basing expr is pointer 
info: SELECT tag: * FROM 

list «> [ctx: CTXIndex], ~- a single context 

record «> [rSei: recordCSEIndex], -- a group of contexts 

hash «> [ctxHti: HTIndex], -- a single identifier 

ENDCASE]; 

ContextStack: TYPE « DESCRIPTOR FOR ARRAY OF ContextEntry; 
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ctxStack: ContextStack; 
ctxindex: INTEGER; 
Contextlncr: CARDINAL » 25; 

MakeStack: PROCEDURE [size: CARDINAL] RETURNS [ContextStack] - 
BEGIN 

OPEN SystemDefs; 

base: POINTER ■ AnocateSegment[size*SIZE[ContextEntry]]; 
RETURN [DESCRIPTOR[base, SegmentSize[base]/SIZE[ContextEntry]]] 
END; 

FreeStack: PROCEDURE [s: ContextStack] ■ 
BEGIN 

OPEN SystemDefs; 

IF LENGTH [s] > THEN FreeSegment[BASE[s]] ; 
RETURN 
END; 

ExpandStack: PROCEDURE - 
BEGIN 

i: CARDINAL; 

oldstack: ContextStack ♦■ ctxStack; 
CtxStack <r MakeStack[LENGTH[o1dstack]+ContextIncr]; 

FOR i IN [0 .. LENGTH[o1dstack]) DO ctxStack[i] ^ oldstack[i] ENDLOOP; 
Frees tack [old stack]; 
RETURN 
END; 



PushCtx: PUBLIC PROCEDURE [ctx: CTXIndex] » 
BEGIN 

IF (ctxindex <- ctxIndex+1) >» LENGTH[ctxStack] THEN ExpandStack[] ; 
ctxStack[ctxIndex] ♦- ContextEntry[ 

base: empty. 

indirect: FALSE, 

info: 1ist[ctx: ctx]]; 
RETURN 
END; 

ReplaceCtx: PUBLIC PROCEDURE [old. new: CTXIndex] » 
BEGIN 

i: INTEGER; 

FOR i IN [0. .ctxindex] DO 
WITH ctxStack[i] SELECT FROM 

list »> IF ctx = old THEN ctx <- new; 
ENDCASE; 
ENDLOOP; 
RETURN 
END; 

SetCtxBase: PROCEDURE [base: TreeLink. indirect: BOOLEAN] « 
BEGIN 

IF -testtree[base, openexp] THEN ERROR; 

ctxStack[ctxIndex].base <- base; ctxStack[ctxIndex]. indirect ^ indirect; 
RETURN 
END; 

PushRecordCtx: PROCEDURE [rSei: recordCSEIndex, base: TreeLink. indirect: BOOLEAN] » 
BEGIN 

IF (ctxindex <- ctxindex+l) >= LENGTH[ctxStack] THEN ExpandStack[]; 
ctxStack[ctxIndex] ♦- ContextEntry[ 

base: base, 

indirect: indirect, 

info: record[rSei: rSei]]; 
END; 

UpdateRecordCtx: PROCEDURE [type: recordCSEIndex] » 
BEGIN 
WITH ctxStack[ctxIndex] SELECT FROM 

record «> rSei ^ type; 

ENDCASE -> ERROR; 
RETURN 
END; 

PushHtCtx: PROCEDURE [liti: HTIndex, base: TreeLink, indirect: BOOLEAN] - 



Pass3I.mesa 2-Sep-78 12:59:59 Page 



BEGIN 

IF (ctxlndex ^ ctxlndex+l) >« LENGTH[ctxStack] THEN ExpandStack[]; 

ctxStack[ctxIndex] *• ContextEntry[ 

base: base, 

indirect: indirect, 

info: hash[ctxHti: hti]]; 
RETURN 
END; 

PopCtx: PUBLIC PROCEDURE - 

BEGIN ctxlndex ^ ctxIndex-1; RETURN 
END; 

TopCtx: PUBLIC PROCEDURE RETURNS [CTXIndex] - 
BEGIN 
WITH ctxStack[ctxIndex3 SELECT FROM 

list «> RETURN [ctx]; 

ENDCASE => ERROR; 
END; 

-- primary lookup 

FindSe: PUBLIC PROCEDURE [hti: HTIndex] RETURNS [ISEIndex. TreeLink, BOOLEAN] 
BEGIN 

i: INTEGER; 
found: BOOLEAN; 
nHits: CARDINAL; 
sei: ISEIndex; 

FOR i DECREASING IN [0 .. ctxlndex] 
DO 

WITH ctxStack[i] SELECT FROM 
list «> 
BEGIN 

[found, sei] ♦- SearchCtxList[hti , ctx]; 
IF found THEN GO TO Found; 
END; 
record »> 
BEGIN 

[nHits, sei] ^ SearchRecord[hti , rSei]; 
IF nHits ff 
THEN 
BEGIN 

IF nHits # 1 THEN sei <- SIGNAL Ambiguousldentif ier[sei]; 
GO TO Found; 
END; 
END; 
hash => 

IF hti « ctxHti THEN BEGIN sei <- ISENull; GO TO Found END; 
ENDCASE; 
REPEAT 

Found => RETURN [sei, ctxStack[i] . base, ctxStack[i]. indirect]; 
FINISHED => 

BEGIN sei *- SIGNAL Undecl aredldentif ier[hti]; 
RETURN [sei, empty, FALSE] 
END; 
ENDLOOP; 
END; 

SearchCtxList: PUBLIC PROCEDURE [hti: HTIndex, ctx: CTXIndex] 
RETURNS [found: BOOLEAN, sei: ISEIndex] » 
BEGIN 

IF ctx « CTXNull THEN RETURN [FALSE, ISENull]; 
WITH c: (ctxb+ctx) SELECT FROM 
included «> 

IF c. restricted 
THEN 
BEGIN 

sei <- SearchRestrictedCtx[hti , LOOPHOLE[ctx]] ; 
found <- (sei j^ SENull); 

IF found AND ~(seb+sei ) .publ ic AND -(mdb+c. ctxmodule) .mdshared 
AND sei If dataPtr . seAnon 
THEN ErrorDef s .errorhti[noAccess , hti]; 
END 
ELSE 
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BEGIN 

sei ^ SearchContext[ht1 , ctx]; 

IF sei # SENull 

THEN found ^ (seb+sei) .pub! ic OR (mdb+c.ctxmodule) .mdshared 
ELSE IF '-c.ctxclosed AND -c.ctxreset 
THEN 

[found, sei] *- CopierDefs.SearchFileCtx[hti , L00PH0LE[ctx3] 
ELSE found ^ FALSE; 
END; 
imported ■> 
BEGIN 

sei ♦- SearchContext[hti , ctx]; 
IF sei « SENull 

AND (mdb+(ctxb+c. includeLink) .ctxmodule) .mdEx ported 
AND (ctxb+c. includeLink) .ctxlevel ■ IG 
THEN 
BEGIN 

sei ♦- SearchContext[hti , dataPtr.mainCtx]; 
IF sei # SENull AND (~CheckExport[sei] OR NamedImport[ctx]) 

THEN sei <- ISENull; 
END; 
IF sei # SENull 

THEN found *- TRUE 
ELSE 
BEGIN 

[found, sei] ^ SearchCtxList[hti , c. includeLink]; 
IF found AND -(seb+sei) . constant AND sei # dataPtr.seAnon 
THEN 

BEGIN CopierDef S.Del ink[sei]; (seb+sei) .ctxnum ^ ctx; 
setsel ink[sei , (ctxb+ctx) .sei ist] ; (ctxb+ctx) .sei ist ^ sei; 
END; 
END; 
END; 
ENDCASE «> 

BEGIN sei ^ SearchContext[hti , ctx]; found ^ (sei # SENull) END; 
RETURN 
END; 

CheckExport: PROCEDURE [sei: ISEIndex] RETURNS [BOOLEAN] - 
BEGIN 

declNode: Treelndex; 
loop: BOOLEAN; 

IF -(seb+sei). public THEN RETURN [FALSE]; 
IF -(seb+sei), mark3 
THEN 

BEGIN 

declNode ^ (seb+sei) . idvalue; 

IF (tb+declNode).mark - P3Mark THEN RETURN [FALSE]; 

loop ♦- FALSE; 

Resol veld[sei 

ICheckTypeLoop, CheckExprLoop => 

BEGIN loop ^ TRUE; RESUME [FALSE] END]; 

IF loop THEN RETURN [FALSE]; 

END; 
RETURN [SELECT XferMode[( seb+sei ). idtype] FROM 

procedure, signal, error, program «> (seb+sei) . constant, 

ENDCASE »> FALSE] 
END; 

Namedlmport: PROCEDURE [ctx: CTXIndex] RETURNS [BOOLEAN] - 
BEGIN 

sei: ISEIndex; 
type: CSEIndex; 
IF dataPtr.importCtx i^ CTXNull THEN 

FOR sei <- (ctxb+dataPtr.importCtx).selist, NextSe[sei] UNTIL sei ° SENull 
DO 

type <- UnderType[(seb+sei) . idtype]; 
WITH (seb+type) SELECT FROM 
definition ■> 
IF defCtx » ctx 

THEN RETURN [(tb+L00PHOLE[( seb+sei ). idvalue. Treelndex]) . attrl] ; 
ENDCASE; 
ENDLOOP; 
RETURN [TRUE] 
END; 
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-- searching records 

SearchRecordSegment: PROCEDURE 

[hti: HTIndex, rSei: recordCSEIndex, suffixed: BOOLEAN] 
RETURNS [nHits: CARDINAL, sei: ISEIndex] » 
BEGIN 

tSei: CSEIndex; 
found: BOOLEAN; 
n: CARDINAL; 
match: ISEIndex; 

[found, sei] ^ SearchCtxList[hti , (seb+rSei) .f ieldctx] ; 
nHits *- IF found THEN 1 ELSE 0; 
IF (seb+rSei) .variant 
THEN 
BEGIN 

tSei ^ UnderType[(seb+UnionFie1d[rSei]). idtype]; 
WITH (seb+tSei) SELECT FROM 
union »> 
BEGIN 

IF '-suffixed AND -controlled AND overlayed 
THEN 
BEGIN 

[n, match] <- SearchOver1ays[hti , casectx]; 
IF -found THEN sei ^ match; 
nHits ^ nHits + n; 
END; 
IF controlled AND (seb+tagsei) . htptr =» hti 

THEN BEGIN sei ♦- tagsei; nHits <- nHits + 1 END; 
END; 
ENDCASE «> NULL; 
END; 
RETURN 
END; 

SearchOverlays: PROCEDURE [hti: HTIndex. ctx: CTXIndex] 
RETURNS [nHits: CARDINAL, sei: ISEIndex] « 
BEGIN 

vSei: ISEIndex; 
rSei: SEIndex; 
n: CARDINAL; 
match: ISEIndex; 
WITH (ctxb+ctx) SELECT FROM 

included => CopierDef s.CompleteContext[LOOPHOLE[ctx] , FALSE]; 
ENDCASE; 
nHits *- 0; sei <- ISENull ; 

FOR vSei <- (ctxb+ctx) . sei ist, NextSe[vSei] UNTIL vSei « SENull 
DO 

rSei <- (seb+vSei). idinfo; 
WITH r: (seb+rSei) SELECT FROM 
id «> NULL; 
constructor «> 

WITH r SELECT FROM 
record «> 
BEGIN 

[n, match] <- SearchRecordSegment[hti , LOOPHOLE[rSei] , FALSE]; 
IF nHits = THEN sei <- match; 
nHits ^ nHits + n; 
END; 
ENDCASE => ERROR; 
ENDCASE; 
ENDLOOP; 
RETURN 
END; 

SearchRecord: PROCEDURE [hti: HTIndex, type: recordCSEIndex] 

RETURNS [nHits: CARDINAL, sei: ISEIndex] » 
BEGIN 

rSei: recordCSEIndex; 
suffixed: BOOLEAN; 
rSei <- type; suffixed <- FALSE; 
UNTIL rSei » SENull 

DO 

[nHits, sei] <- SearchRecordSegment[hti , rSei, suffixed]; 

IF nHits ^ THEN RETURN; 
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rSei ^ WITH (seb+rSei) SELECT FROM 

linked »> LOOPHOLE[UnderType[l inktype]]. 
ENDCASE »> recordCSENull; 
suffixed *• TRUE; 
ENDLOOP; 
RETURN [0. ISENull] 
END; 

-- management of restricted contexts 

CtxRestriction: TYPE - RECORD [ctx: includedCTXIndex. list: TreeLink]; 

ctxIdTable: DESCRIPTOR FOR ARRAY OF CtxRestriction; 
ctxIdTableLimit: CARDINAL; 

GetDirectorylds: PUBLIC TreeScan ■ 
BEGIN 

node: Treelndex » GetNode[t]; 
savelndex: CARDINAL » dataPtr.textlndex; 
dataPtr.textlndex ♦- (tb+node) . info; 
WITH (tb+node). sonl SELECT FROM 
symbol «> 
BEGIN 

sei: ISEIndex » index; 

type: CSEIndex = UnderType[(seb+sei) . idtype]; 
bti: BTIndex; 
WITH (seb+type) SELECT FROM 

definition => (tb+node) . son3 ^ Inc1udedIds[defCtx, (tb+node) . son3]; 
transfer => 

IF (bti <- (seb+sei).idinfo) # BTNull 

THEN (tb+node). sons ^ Inc1udedlds[(bb+bti ) . localCtx, (tb+node) . sonS]; 
ENDCASE => NULL; 
END; 
ENDCASE => ERROR; 
dataPtr.textlndex <- savelndex; RETURN 
END; 

Includedlds: PROCEDURE [ctx: CTXIndex, list: TreeLink] RETURNS [val : TreeLink] « 
BEGIN 
iCtx: includedCTXIndex; 

Includedid: TreeMap - 
BEGIN 

WITH t SELECT FROM 
hash «> 
BEGIN 

hti: HTIndex ■ index; 
sei: ISEIndex; 
found, duplicate: BOOLEAN; 

CheckDupl icate: TreeScan « 
BEGIN 
WITH t SELECT FROM 

symbol => IF index = sei THEN duplicate <- TRUE; 

ENDCASE; 
RETURN 
END; 

sei *- SearchContext[hti , ctx]; 
IF sei = SENull 

THEN [found, sei] <- CopierDef s .SearchFileCtx[hti , iCtx] 
ELSE 
BEGIN 

found ^ TRUE; duplicate <- FALSE; scanl ist[l ist , CheckDupl icate] ; 
IF duplicate THEN ErrorDef s .errorhti[dupl icateld, hti] 
END; 
IF found 
THEN 

BEGIN (seb+sei).ctxnum ♦- CTXNull; v ^ [symbol[index: sei]] END 
ELSE 

BEGIN ErrorDef s.errorhti[unknownId. hti]; v <- t END; 
END; 
ENDCASE «> ERROR; 
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RETURN 
END; 

SELECT (ctxb+ctx).ctxTyp0 FROM 
included ■> 

BEGIN iCtx ♦- LOOPHOLE[ctx]; 
IF {(ctxb+iCtx). restricted ♦- list i^ empty) 
THEN 
BEGIN 

(mdb+(ctxb+iCtx).ctxmodu1e) .mdshared ♦- TRUE; 
val <- update! ist[1 ist, Includedid]; 
(mdb+(ctxb+iCtx) .ctxmodule) .mdshared <- FALSE; 
ctxIdTable[ctxIdTableLimit] <- CtxRestriction[iCtx, val]; 
ctxIdTableLimit ^ ctxIdTableLimit + 1; 
END 
ELSE val *- empty; 
END; 
ENDCASE; 
RETURN 
END; 



CheckDirectorylds: PUBLIC TreeScan » 
BEGIN 

Checkid: TreeScan ■ 
BEGIN 

WITH t SELECT FROM 
symbol «> 

IF (seb+index) .ctxnum » CTXNull 

THEN ErrorDef s.WarningSei[unusedId, index]; 
ENDCASE; 
RETURN 
END; 

node: Treelndex «= GetNode[t]; 
savelndex: CARDINAL = dataPtr . textlndex; 
dataPtr.textlndex <- (tb+node) . info; 
scan! ist[( tb+node) . son3, Checkid]; 
dataPtr.textlndex *- savelndex; RETURN 
END; 

SearchRestrictedCtx: PROCEDURE [hti: HTIndex, ctx: includedCTXIndex] 
RETURNS [sei: ISEIndex] - 
BEGIN 

Testid: TreeScan ■ 
BEGIN 
WITH t SELECT FROM 

hash => IF index ■ hti THEN sei *- dataPtr . seAnon; 
symbol «> 

IF (seb+index) .htptr » hti 
THEN 
BEGIN 

sei ♦- index; 
SELECT (seb+sei). ctxnum FROM 

CTXNull =»> (seb+sei) .ctxnum ♦- ctx; 
ctx «> NULL; 

ENDCASE «> [ , sei] ♦- CopierDef s.SearchFileCtx[hti , ctx]; 
END; 
ENDCASE; 
RETURN 
END; 

i: CARDINAL; 

FOR i IN [0 ., CtxIdTableLimit) 

DO 

IF ctxIdTable[i].ctx » ctx THEN EXIT; 

REPEAT 

FINISHED -> ERROR; 

ENDLOOP; 
sei <- ISENull; scanl ist[ctxIdTable[i] . 1 ist . Testid]; RETURN 
END; 
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CheckDisjoint: PUBLIC PROCEDURE [ctxl. ctx2: CTXIndex] ■ 
BEGIN 

sei: ISEIndex; 
hti: HTIndex; 

savelndex: CARDINAL - dataPtr . textlndex; 
IF ctxl # CTXNull AND ctx2 # CTXNull 
THEN 

FOR sei ^ (ctxb+ctx2).selist, NextSe[sei] UNTIL sei « SENull 
DO 

hti ^ (seb+sei) .htptr; 

IF hti # HTNull AND SearchContextChti , ctxl] H' SENull 
THEN 
BEGIN 
IF -(seb+sei) .marks 

THEN dataPtr. textlndex ^ 

(tb+LOOPHOLE[(seb+sei).idvalue, Tree Index]) .info; 
ErrorDefs .errorhti[dupl icateld, hti]; 
END; 
ENDLOOP; 
dataPtr. textlndex ♦- savelndex; RETURN 
END; 

-- basing management 

BaseTree: PROCEDURE [t: TreeLink, type: CSEIndex] RETURNS [val : TreeLink] « 
BEGIN 

m1push[t]; pushtree[openexp, 1]; setinfo[type]; setattr[l, FALSE]; 
val ♦- mlpop[]; setshared[val . TRUE]; RETURN 
END; 

OpenBase: PUBLIC PROCEDURE [t: TreeLink, hti: HTIndex] RETURNS [v: TreeLink] 
BEGIN 
type, vType: CSEIndex; 

OpenRecord: PROCEDURE [indirect: BOOLEAN] « 
BEGIN 

WITH (seb+type) SELECT FROM 
record «> 
BEGIN 

V ♦- BaseTree[v, vType]; 
IF hti # HTNull 

THEN PushHtCtx[hti. v, indirect] 

ELSE PushRecordCtxiLOOPHOLE[type, recordCSEIndex] , v. indirect]; 
END; 
ENDCASE «> IF type # typeANY THEN ErrorDefs .errortree[typeClash , v]; 
RETURN 
END; 

V ♦- Exp[t, typeANY]; 

vType ♦- RType[]; type <- NormalType[vType]; RPop[]; 
WITH (seb+type) SELECT FROM 
definition «> 

BEGIN 

IF hti # HTNull THEN ErrorDefs . errorhti[openId , hti]; 

PushCtx[defCtx]; 

END; 
pointer «> 

BEGIN 

dereferenced <- TRUE; type ♦- UnderType[pointedtotype]; 

OpenRecord[TRUE]; 

END; 
ENDCASE -> OpenRecord[FALSE]; 
RETURN 
END; 

CloseBase: PUBLIC PROCEDURE [t: TreeLink, hti: HTIndex] - 
BEGIN 
type: CSEIndex; 

CloseRecord: PROCEDURE - 
BEGIN 

WITH (seb+type) SELECT FROM 
record «> PopCtx[]; 



PassSI.mesa 2-Sep-78 12:59:59 Page 13 



ENDCASE; 
RETURN 
END; 

type ^ Norma1Type[0perandType[t]]; 
WITH (seb+type) SELECT FROM 

definition -> BEGIN IF hti # HTNull THEN NULL; PopCtx[] END; 

pointer »> BEGIN type ♦- UnderType[pointedtotype]; CloseRecord[] END; 

ENDCASE «> C1oseRecord[]; 
RETURN 
END; 

-- binding of variant records 

Discrimination: PUBLIC PROCEDURE [node: Treelndex, selection: TreeMap] ■ 
BEGIN OPEN (tb+node); 
idNode: Treelndex; 

type, subType, uType, tagType: CSEIndex; 
vCtx: CTXIndex; 
base, baseld: TreeLink; 

saveType: CSEIndex » passPtr. imp! icitType; 
saveTree: TreeLink « passPtr . imp! icitTree; 

BindError: PROCEDURE - 
BEGIN 

IF son2 # empty THEN son2 <- VoidExp[son2]; 
vCtx ^ CTXNull; tagType ♦- typeANY; 
RETURN 
END; 

Bindltem: TreeScan ■ 
BEGIN 

subNode: Treelndex; 
vType: CSEIndex; 

savelndex: CARDINAL ■ dataPtr. textlndex; 
WITH t SELECT FROM 
subtree «> 

BEGIN subNode <- index; 

dataPtr. textlndex <- (tb+subNode) . info; 

[(tb+subNode) .sonl , vType] <- BindTest[(tb+subNode) .sonl. vCtx]; 

SetBaseType[base, vType]; 

IF baseld « nullid AND (seb+vType) . typetag = record 

THEN UpdateRecordCtx[L0OPH0LE[vType, recordCSEIndex]] ; 
(tb+subNode) .son2 ♦- selection[{tb+subNode) .son2]; 
IF baseld « nullid AND (seb+type) . typetag « record 

THEN UpdateRecordCtx[L00PH0LE[type. recordCSEIndex]]; 
(tb+subNode). attrl ^ TRUE; 
END; 
ENDCASE => ERROR; 
dataPtr .textlndex ♦- savelndex; RETURN 
END; 

WITH sonl SELECT FROM 

subtree «> idNode *- index; 
ENDCASE => ERROR; 
(tb+idNode) .son2 ♦- Exp[( tb+idNode) .son2 , typeANY]; 
subType <- RType[]; RPop[]; type ♦- NormalType[subType]; 
WITH (seb+type) SELECT FROM 
pointer ■> 
BEGIN 

dereferenced ♦- TRUE; type ♦- UnderType[pointedtotype]; 
m1push[(tb+idNode) .son2]; pushtree[uparrow, 1]; 
setinfo[type]; setattr[l, (seb+subType) . typetag » long]; 
base ^ mlpop[]; 
END; 
ENDCASE => base <- (tb+idNode) . son2; 
baseld «- (tb+idNode) . sonl; 
WITH (seb+type) SELECT FROM 
record »> 
BEGIN 

(tb+idNode) .son2 *- base ♦- BaseTree[base, type]; 
IF baseld « nullid 

THEN PushRecordCtx[LO0PH0LE[type, recordCSEIndex], base, FALSE] 
ELSE 

WITH (tb+idNode). sonl SELECT FROM 
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hash ■> PushHtCtx[index, base, FALSE]; 
ENDCASE «> ERROR; 
IF variant 
THEN 

BEGIN uType ^ VariantUnionType[type]; 
WITH (seb+uType) SELECT FROM 
union ■> 
BEGIN 

vCtx ^ casectx; 

tagType ^ UnderType[(seb+tagsei) . idtype]; 
IF sonZ ■ empty 
THEN 
BEGIN 

IF -controlled THEN ErrorDef s .error[missingBinding] ; 
CountTree Ids [base]; mlpush[base]; 
ml push[TreeLink[synibol[ index: tagsei]]]; 
pushtree[dollar, 2]; 

setinfo[tagType]; setattr[l, LongPath[base]] ; 
son2 *- mlpop[]; 
END 
ELSE 
BEGIN 
IF controlled 

THEN ErrorDefs.errortree[spuriousBinding, son2]; 
son2 ^ Rhs[son2, TargetType[tagType]]; 
RPop[]: 
END; 
END; 
ENDCASE «> 

BEGIN ErrorDefs.error[noAccess]; BindError[] END; 
END 
ELSE 

BEGIN ErrorDefs,errortree[no\/ariants, (tb+idNode) .son2]; 
BindError[]; 
END; 
END; 
ENDCASE -> 

BEGIN ErrorDefs.errortree[noVariants, (tb+idNode) .son2]; 
BindError[]; 
END; 
passPtr. impl icitType *- tagType; passPtr. impl icitTree ^ son2; 
scanl ist[son3, Bindltem]; 

SetBaseType[base, type]; son4 <- selection[son4]; 
WITH (seb+type) SELECT FROM 
record => PopCtx[]; 
ENDCASE; 
passPtr. impl icitType <- saveType; passPtr. impl icitTree ^ saveTree; 
RETURN 
END; 

SetBaseType: PROCEDURE [base: TreeLink, type: CSEIndex] ■ 
BEGIN 

IF base # empty 
THEN 

WITH base SELECT FROM 

subtree «> (tb+index) . info <- type; 
ENDCASE »> NULL; 
RETURN 
END; 

BindTest: PROCEDURE [t: TreeLink, vCtx: CTXIndex] RETURNS [val : TreeLink, vType: CSEIndex] 
BEGIN 
mixed: BOOLEAN; 

Testltem: TreeMap « 
BEGIN 

subNode: Treelndex; 
iType: ISEIndex; 
uType: CSEIndex; 
found: BOOLEAN; 
WITH t SELECT FROM 
subtree ■> 

BEGIN subNode ♦- index; 
SELECT (tb+subNode).name FROM 
relE -> 
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WITH (tb+subNode),son2 SELECT FROM 
hash ■> 
BEGIN 

[found, iType] ^ SearchCtxList[index, vCtx]; 
IF found 
THEN 

BEGIN uType ♦- UnderTyp0[iType]; 

(tb+subNode).son2 ^ TreeLink[symbo1[index: iType]]; 
SELECT vType FROM 
uType «> NULL; 
typeANY »> vType ^ uType; 
ENDCASE => mixed ^ TRUE; 
END 
ELSE 

IF vCtx » CTXNull 

THEN ErrorD0fs.errorhti[unknownVariant, index]; 

V ♦- t; 
END; 

ENDCASE -> 
BEGIN 

V *- Rhs[t. dataPtr.typeBOOLEAN]; RPop[]; 
ErrorDefs.errortree[nonVariantLabel , t]; 
END; 

ENDCASE -> 
BEGIN 

V <- Rhs[t, dataPtr.typeBOOLEAN]: RPop[]; 
ErrorDefs.errortree[nonVariantLabel , t]; 
END; 
END; 
ENDCASE »> ERROR; 
RETURN 
END; 

vType ^ typeANY; mixed <- FALSE; 
val ♦- update! ist[t, Testltem]; 
IF mixed THEN vType <- typeANY; 
RETURN 
END; 



-- initial ization/final ization 

Idlnit: PUBLIC PROCEDURE [nIdLists: CARDINAL] « 
BEGIN 

ctxStack ^ MakeStack[2*ContextIncr]; ctxindex <- -1; 
seqNumber ^ 0; 
ctxIdTable ^ DESCRIPTOR[ 

SystemDef s. Al 1ocateHeapNode[nIdLists*SIZE[CtxRestriction]], 
nIdLists]; 
ctxIdTableLimit ♦- 0; 
RETURN 
END; 

IdFinish: PUBLIC PROCEDURE - 
BEGIN 

SystemDefs.FreeHeapNode[BASE[ CtxIdTable]]; 
Frees tack [ctxStack]; RETURN 
END; 

END. 



